home *** CD-ROM | disk | FTP | other *** search
- ;* INLINE.ASH
- ;************************************************************************
- ;* *
- ;* PC Scheme/Geneva 4.00 Borland TASM code *
- ;* *
- ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT *
- ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva *
- ;* *
- ;*----------------------------------------------------------------------*
- ;* *
- ;* 8086 Assembly macros for creating inline FSL's *
- ;* *
- ;*----------------------------------------------------------------------*
- ;* *
- ;* Created by: John Jensen Date: 1985 *
- ;* Revision history: *
- ;* - 18 Jun 92: Renaissance (Borland Compilers, ...) *
- ;* *
- ;* ``In nomine omnipotentii dei'' *
- ;************************************************************************
- IDEAL
- INCLUDE "assembly.ash"
- MODEL TINY
- CODESEG
- db '#!fast-load 4.0, assembly code "', ??filename, '", '
- db ??date, ' ', ??time, 0dh, 0ah
-
- MACRO HEXNIBBLE datum
- T = datum
- IF T GE 10
- DB T + 'A' - 10
- ELSE
- DB T + '0'
- ENDIF
- ENDM
-
- MACRO startinline name, args
- PROC name FAR
- db 'h0002 0015', 0dh, 0ah
- ARGCOUNT = args
- db 'x'
- LABEL @@namelen
- db '00'
- db "&name", 0dh, 0ah
- LABEL @@nameend
- NAMESIZE = @@nameend - @@namelen - 4
- ORG @@namelen
- HEXNIBBLE <(NAMESIZE shr 4) and 0fh>
- HEXNIBBLE <NAMESIZE and 0fh>
- ORG @@nameend
-
- db 'm'
- LABEL @@codelen
- db '0000'
- ENDM
-
- MACRO endinline
- LABEL @@codeend
- CODESIZE = @@codeend - @@codelen - 4
- ORG @@codelen
- REPT 4
- HEXNIBBLE <(CODESIZE shr 12) and 0fh>
- CODESIZE = CODESIZE shl 4
- ENDM
- ORG @@codeend
- db 0dh, 0ah, 't'
- VM_MVC R1, 0
- VM_CLO R1, @@closure, ARGCOUNT
- VM_DEF R1, 0
- VM_MVC R1, 0
- VM_EXIT
- LABEL @@closure
- VM_MVC R62, 1
- VM_EXEC R62
- VM_EXIT
- DB 0dh, 0ah, 'z', 0dh, 0ah
- ENDP
- ENDM
-
- ldpage EQU [DWORD di+00h]
- alloc_big_block EQU [DWORD di+04h]
- alloc_block EQU [DWORD di+08h]
- alloc_flonum EQU [DWORD di+0ch]
- alloc_int EQU [DWORD di+10h]
- alloc_list_cell EQU [DWORD di+14h]
- alloc_string EQU [DWORD di+18h]
- cons EQU [DWORD di+1ch]
- free EQU [DWORD di+20h]
- getch EQU [DWORD di+24h]
- get_max_cols EQU [DWORD di+28h]
- get_max_rows EQU [DWORD di+2ch]
- int2long EQU [DWORD di+30h]
- is_graph_mode EQU [DWORD di+34h]
- long2int EQU [DWORD di+38h]
- malloc EQU [DWORD di+3ch]
- nosound EQU [DWORD di+40h]
- sound EQU [DWORD di+44h]
- zcuroff EQU [DWORD di+48h]
- zcuron EQU [DWORD di+4ch]
- zprintf EQU [DWORD di+50h]
- zputc EQU [DWORD di+54h]
- zscroll EQU [DWORD di+58h]
- zscroll_d EQU [DWORD di+5ch]
-
- reg0 EQU (REG si+00h)
- reg1 EQU (REG si+04h)
- reg2 EQU (REG si+08h)
- reg3 EQU (REG si+0ch)
- reg4 EQU (REG si+10h)
- reg5 EQU (REG si+14h)
- reg6 EQU (REG si+18h)
- reg7 EQU (REG si+1ch)
- reg8 EQU (REG si+20h)
- reg9 EQU (REG si+24h)
- reg10 EQU (REG si+28h)
- reg11 EQU (REG si+2ch)
- reg12 EQU (REG si+30h)
- reg13 EQU (REG si+34h)
- reg14 EQU (REG si+38h)
- reg15 EQU (REG si+3ch)
- reg16 EQU (REG si+40h)
- reg17 EQU (REG si+44h)
- reg18 EQU (REG si+48h)
- reg19 EQU (REG si+4ch)
- reg20 EQU (REG si+50h)
- reg21 EQU (REG si+54h)
- reg22 EQU (REG si+58h)
- reg23 EQU (REG si+5ch)
- reg24 EQU (REG si+60h)
- reg25 EQU (REG si+64h)
- reg26 EQU (REG si+68h)
- reg27 EQU (REG si+6ch)
- reg28 EQU (REG si+70h)
- reg29 EQU (REG si+74h)
- reg30 EQU (REG si+78h)
- reg31 EQU (REG si+7ch)
- reg32 EQU (REG si+80h)
- reg33 EQU (REG si+84h)
- reg34 EQU (REG si+88h)
- reg35 EQU (REG si+8ch)
- reg36 EQU (REG si+90h)
- reg37 EQU (REG si+94h)
- reg38 EQU (REG si+98h)
- reg39 EQU (REG si+9ch)
- reg40 EQU (REG si+0a0h)
- reg41 EQU (REG si+0a4h)
- reg42 EQU (REG si+0a8h)
- reg43 EQU (REG si+0ach)
- reg44 EQU (REG si+0b0h)
- reg45 EQU (REG si+0b4h)
- reg46 EQU (REG si+0b8h)
- reg47 EQU (REG si+0bch)
- reg48 EQU (REG si+0c0h)
- reg49 EQU (REG si+0c4h)
- reg50 EQU (REG si+0c8h)
- reg51 EQU (REG si+0cch)
- reg52 EQU (REG si+0d0h)
- reg53 EQU (REG si+0d4h)
- reg54 EQU (REG si+0d8h)
- reg55 EQU (REG si+0dch)
- reg56 EQU (REG si+0e0h)
- reg57 EQU (REG si+0e4h)
- reg58 EQU (REG si+0e8h)
- reg59 EQU (REG si+0ech)
- reg60 EQU (REG si+0f0h)
- reg61 EQU (REG si+0f4h)
- reg62 EQU (REG si+0f8h)
- reg63 EQU (REG si+0fch)
-
- ; structures stolen from SCHEME.ASH
-
- ; Page attribute bits
- ATOM = 08000H ; 1 = Atomic data
- LISTCELL = 04000H ; 1 = List (cons) cells
- FIXNUMS = 02000H ; 1 = 16-bit integer data
- FLONUMS = 01000H ; 1 = 32-bit floating point data
- BIGNUMS = 00800H ; 1 = big integer values
- SYMBOLS = 00400H ; 1 = symbols
- STRINGS = 00200H ; 1 = strings
- VECTORS = 00100H ; 1 = vector (array) storage
- NOMEMORY = 00080H ; 1 = no memory allocated
- READONLY = 00040H ; 1 = memory is read only (constant)
- CONTINU = 00020H ; 1 = continuation object
- CLOSURE = 00010H ; 1 = closure object
- I86CODE = 00008H ; 1 = inline 8086 code
- PORTS = 00004H ; 1 = I/O ports
- CODE = 00002H ; 1 = code block
- CHARS = 00001H ; 1 = characters
- NUMBERS = FIXNUMS+FLONUMS+BIGNUMS ; number (fixnums, flonums, bignums)
-
- ; Data type equates (classes of data objects)
- NUMTYPES = 15 ; Number of data types
- LISTTYPE = 0
- FIXTYPE = 2
- FLOTYPE = 4
- BIGTYPE = 6
- SYMBTYPE = 8
- STRTYPE = 10
- VECTTYPE = 12
- CONTTYPE = 14
- CLOSTYPE = 16
- FREETYPE = 18
- CODETYPE = 20
- I86TYPE = 22
- PORTTYPE = 24
- CHARTYPE = 26
- ENVTYPE = 28
-
- ; Special pre-allocated pages
- SPECCHAR = 1
- SPECFREE = 2
- SPECFIX = 3
- SPECFLO = 4
- SPECSYM = 5
- SPECPOR = 6
- SPECCODE = 7
-
- STRUC REG
- disp DW ?
- LABEL bpage BYTE
- page DW ?
- ENDS REG
-
-
- STRUC POINTER
- page DB ?
- disp DW ?
- ENDS POINTER
-
- STRUC FIXNUM
- tag DB SPECFIX*2
- val DW ?
- ENDS FIXNUM
-
- ; Generic object (inherited)
- STRUC ANYDEF
- UNION
- tag DB ?
- gc DB ?
- ENDS
- len DW ?
- data POINTER <>
- ENDS ANYDEF
-
- ; Free cell (!)
- STRUC FREEDEF
- UNION
- tag DB FREETYPE
- gc DB ?
- ENDS
- len DW ?
- ENDS FREEDEF
-
- ; Free linked list cell
- STRUC FREELISTDEF
- tag DB SPECFREE*2
- next DW ? ; pointer to next free cell in page
- ENDS FREELISTDEF
-
- ; List Cell
- ; +-------------v-+-------------------------------+
- ; | car page # |g| car displacement |
- ; +-------------^-+-------------------------------+
- ; | cdr page # |0| cdr displacement |
- ; +---------------+-------------------------------+
- ; where g = used during garbage collection
- STRUC LISTDEF
- UNION
- car POINTER <>
- ptr POINTER <>
- gc DB ?
- ENDS
- cdr POINTER <>
- ENDS LISTDEF
-
- ; Bignum
- ; +-------------v-+-------------------------------+
- ; | BIGTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | sign | least significant word |
- ; +---------------+--------------------------------
- ; : :
- ; +-------------------------------+
- ; | most significant word |
- ; +-------------------------------+
- ; where g = used during garbage collection
- STRUC BIGDATA
- len DW ? ; length of entire data structure in bytes
- sign DB ? ; sign of the bignum
- lsw DW ? ; data bits, with LSBs appearing first
- msw DW ? ; second word of significant bits
- ENDS BIGDATA
-
- STRUC BIGDEF
- UNION
- tag DB BIGTYPE ; tag = bignum
- gc DB ?
- ENDS
- data BIGDATA ?
- ENDS BIGDEF
-
- ; special structure to occupy a vacant slot in a FLONUM page
- STRUC FREEFLODEF
- tag DB FREETYPE
- next DW ? ; pointer to next free cell in page
- ENDS FREEFLODEF
-
- ; Flonum
- ; +-------------v-+---+---+---+---+---+---+---+---+
- ; | FLOTYPE | | 64 bit IEEE floating point |
- ; +-------------^-+---+---+---+---+---+---+---+---+
- ; where g = used during garbage collection
- STRUC FLODEF
- UNION
- tag DB FLOTYPE ; tag = flonum
- gc DB ?
- ENDS
- UNION
- data DQ ?
- ptr POINTER <>
- ENDS
- ENDS FLODEF
-
- ; Vector (Array)
- ; +-------------v-+-------------------------------+
- ; | VECTTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; : data #i pointer :
- ; ------------------------------------------------+
- ; where g = used during garbage collection
- STRUC VECDEF
- UNION
- tag DB VECTTYPE
- gc DB ?
- ENDS
- len DW ?
- LABEL data POINTER
- ENDS VECDEF
-
- ; Symbol
- ; +-------------v-+-------------------------------+
- ; | SYMBTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | link pointer |
- ; +-+-------------+---------------v---------------+
- ; | hash value : characters :
- ; +---------------+---------------+
- ; where g = used during garbage collection
- STRUC SYMDEF
- UNION
- tag DB SYMBTYPE ; tag = symbol
- gc DB ?
- ENDS
- len DW ? ; length of symbol structure in bytes
- link POINTER <>
- hashkey DB ? ; hash key
- LABEL buffer BYTE ; character(s) in symbol
- ENDS SYMDEF
-
- ; String
- ; +-------------v-+-------------------------------+
- ; | STRTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; : characters :
- ; +---------------+
- ; where g = used during garbage collection
- STRUC STRDEF
- UNION
- tag DB STRTYPE ; tag = string
- gc DB ?
- ENDS
- len DW ? ; length of string structure in bytes
- LABEL buffer BYTE ; character(s) in string
- ENDS STRDEF
-
- MACRO sstrlen dest, pntr, ohead
- LOCAL @@bigstring, @@allstrings
- mov dest, [(STRDEF pntr).len]
- or dest, dest
- jge @@bigstring
- IFIDN <ohead>, <OVERHEAD>
- add dest, OFFSET (TYPE STRDEF).buffer + SIZE POINTER
- @@bigstring:
- ELSE
- add dest, SIZE POINTER
- jmp @@allstrings
- @@bigstring:
- sub dest, OFFSET (TYPE STRDEF).buffer
- @@allstrings:
- ENDIF
- ENDM
-
- ; Closure
- ; +-------------v-+-------------------------------+
- ; | CLOSTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | information operand pointer |
- ; +---------------+-------------------------------+
- ; | heap environment pointer |
- ; +---------------+-------------------------------+
- ; | code block pointer |
- ; +---------------+-------------------------------+
- ; | SPECFIX*2 | Entry Point Displacement |
- ; +---------------+-------------------------------+
- ; | SPECFIX*2 | Number of Arguments |
- ; +---------------+-------------------------------+
- ; where g = used during garbage collection
- STRUC CLOSDEF
- UNION
- tag DB CLOSTYPE ; tag = closure
- gc DB ?
- ENDS
- len DW ? ; length of closure object in bytes
- info POINTER <> ; information operand
- heap POINTER <> ; heap environment pointer
- codeblk POINTER <> ; code base
- entry FIXNUM <> ; entry point tag = immediate
- args FIXNUM <> ; number of arguments tag = immediate
- LABEL debug BYTE ; optional debugging information?
- ENDS CLOSDEF
-
- ; Continuation
- ; +-------------v-+-------------------------------+
- ; | CONTTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | SPECFIX*2 | stack base of continuation |
- ; +---------------+-------------------------------+
- ; | return address code base pointer |\
- ; +---------------+-------------------------------+ | return address
- ; | SPECFIX*2 | return address displacement |/
- ; +---------------+-------------------------------+
- ; | SPECFIX*2 | caller's dynamic link (FP) |
- ; +---------------+-------------------------------+
- ; | fluid environment pointer (fnv_reg) |
- ; +---------------+-------------------------------+
- ; | previous stack segment (continuation) pointer |
- ; +---------------+-------------------------------+
- ; | global environment pointer (gnv_reg) |
- ; +---------------+-------------------------------+
- ; : :< - BASE
- ; : [contents of stack at call/cc] :
- ; : :< - topofstack
- ; +-----------------------------------------------+
- ; where g = used during garbage collection
- STRUC CONTDEF
- UNION
- tag DB CONTTYPE ; tag = continuation
- gc DB ?
- ENDS
- len DW ? ; length of continuation structure in bytes
- base FIXNUM <>
- codeblk POINTER <> ; return address code base pointer
- retaddr FIXNUM <> ; return address displacement
- dynlink FIXNUM <> ; caller's dynamic link
- fluid POINTER <> ; fluid environment pointer
- stk POINTER <> ; previous stack segment pointer
- globenv POINTER <> ; global environment pointer
- LABEL data BYTE ; contents of stack at call/cc
- ENDS CONTDEF
-
- ; Code Block
- ; +-------------v-+-------------------------------+
- ; | CODETYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | SPECFIX*2 | entry offset |-\
- ; +---------------+-------------------------------+ |
- ; : pointer to constant #i : |
- ; +---------------+---------------+---------------+ |
- ;/----->: code : |
- ;| +---------------+ |
- ;\--------------------------------------------------------/
- ; where g = used during garbage collection
- STRUC CODEDEF
- UNION
- tag DB CODETYPE ; tag = code block
- gc DB ?
- ENDS
- len DW ? ; length of code block in bytes
- entry FIXNUM <> ; entry offset tag = fixnum
- consts POINTER <> ; code block constants area
- ENDS CODEDEF
-
- ; Inline code block
- ; +-------------v-+-------------------------------+
- ; | I86TYPE |g| length in bytes +
- ; +-------------^-+-------------------------------+
- ; : machine code :
- ; +---------------+
- ; where g = used during garbage collection
- STRUC I86DEF
- UNION
- tag DB I86TYPE
- gc DB ?
- ENDS
- len DW ?
- LABEL data BYTE
- ENDS I86DEF
-
- ; Environment Data Object
- ; +-------------v-+-------------------------------+
- ; | ENVTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | parent pointer |
- ; +---------------+-------------------------------+
- ; | list of symbols (linked through cdr field) |
- ; +---------------+-------------------------------+
- ; | list of values (linked through car field) |
- ; +---------------+-------------------------------+
- ; where g = used during garbage collection
- STRUC ENVDEF
- UNION
- tag DB ENVTYPE ; tag = environment
- gc DB ?
- ENDS
- len DW ? ; length in bytes
- parent POINTER <>
- names POINTER <> ; list of names
- values POINTER <> ; list of values
- ENDS ENVDEF
-
- ; Port
- ; +-------------v-+-------------------------------+
- ; | PORTTYPE |g| length in bytes |
- ; +-------------^-+-------------------------------+
- ; | string source pointer |
- ; +---------------+---------------+---------------+---------------+
- ; | port flags | handle |
- ; +---------------+---------------+---------------+---------------+
- ; | cursor line | cursor column |
- ; +---------------+---------------+---------------+---------------+
- ; | upper left line | upper left column |
- ; +---------------+---------------+---------------+---------------+
- ; | number of lines | number of columns |
- ; +---------------+---------------+---------------+---------------+
- ; | border attributes | text attributes |
- ; +---------------+---------------+---------------+---------------+
- ; | window flags | buffer position |
- ; +---------------+---------------+---------------+---------------+
- ; | buffer end : i/o buffer :
- ; +---------------+---------------+---------------+
- ; : window label/file pathname :
- ; +---------------+---------------+
- ; where g = used during garbage collection
- ; 7 6 5 4 3 2 1 0
- ; +-v-v-v-v-v-v---+
- ; port flags: | |s|b|t|o|w|mod|
- ; +-^-^-^-^-^-^---+
- ;
- ; mode: 0 read
- ; 1 write
- ; 2 read and write
- ; w: 0 file
- ; 1 window
- ; o: 0 closed
- ; 1 open
- ; t: 0 transcript disabled
- ; 1 transcript enabled
- ; b: 0 text file/window
- ; 1 binary file/window
- ; s: 0 file/window I/O
- ; 1 string I/O
- ;
- ; 7 6 5 4 3 2 1 0
- ; +-----------v-v-+
- ;window flags: | |e|w|
- ; +-----------^-^-+
- ;
- ; w: 0 clip
- ; 1 wrap
- ; e: 0 exposed
- ; 1 (partially) covered
- BUFFSIZE = 100h
- HISTSIZE = 4 * BUFFSIZE ; history buffer length
-
- STRUC PORTDEF
- UNION
- tag DB PORTTYPE ; tag = port
- gc DB ?
- ENDS
- len DW ? ; length of port structure in bytes
- ptr POINTER <>
- pflags DW ? ; port flags
- handle DW ? ; file's handle
- curline DW ? ; cursor line number
- curcol DW ? ; cursor column number
- LABEL chunk WORD ; chunk ???
- ulline DW ? ; upper left hand corner's line number
- ulcol DW ? ; upper left hand corner's column number
- nlines DW ? ; number of lines
- ncols DW ? ; number of columns/line length
- border DW ? ; window's border attributes
- text DW ? ; window's text attributes
- flags DW ? ; window flags
- bufpos DW ? ; buffer position (offset)
- bufend DW ? ; end of buffer offset
- buffer DB BUFFSIZE DUP (?) ; input/output buffer
- ENDS PORTDEF
-